home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue32 / extlistv / EXTLISTV.ZIP / ExtListView.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-10-18  |  51.1 KB  |  1,484 lines
  1. {$DEFINE DEBUG}
  2.  
  3.  
  4. { -----------------------------------------------------------------------------}
  5. { A list view control that enables access to the new style types provieded by  }
  6. { the updated list view control.                                               }
  7. { Copyright 1996, Brad Stowers.  All Rights Reserved.                          }
  8. { This component can be freely used and distributed in commercial and private  }
  9. { environments, provied this notice is not modified in any way.                }
  10. { -----------------------------------------------------------------------------}
  11. { Feel free to contact me if you have any questions, comments or suggestions   }
  12. { at bstowers@pobox.com or 72733,3374 on CompuServe.                           }
  13. { The lateset version will always be available on the web at:                  }
  14. {   http://www.pobox.com/~bstowers/delphi/                                     }
  15. { -----------------------------------------------------------------------------}
  16. { Date last modified:  October 16, 1997                                        }
  17. { -----------------------------------------------------------------------------}
  18.  
  19. { -----------------------------------------------------------------------------}
  20. { TExtListView v3.00 Beta 8                                                    }
  21. { -----------------------------------------------------------------------------}
  22. {                                                                              }
  23. { Description:                                                                 }
  24. {   A list view control that enables access to the new style types provieded   }
  25. {   by the updated list view control.  The updated list view is provided in    }
  26. {   the COMCTL32.DLL file that comes with Microsoft's new internet software.   }
  27. {   The version I have tested this component with is dated August 26, 1996 at  }
  28. {   09:39.                                                                     }
  29. {                                                                              }
  30. { Notes:                                                                       }
  31. {   The owner drawing and column images were originally implemented by Remi    }
  32. {    Sellem (RemiS@chemware.co.uk) and Mike Lindre (no address).  I only       }
  33. {    reworked them a little, integrated them into this component, and made a   }
  34. {    few changes to use the new Delphi 3 collection editor for ColumnsFormat.  }
  35. {    The original property editor (ExtColEd.pas) for this is provided for      }
  36. {    Delphi 2 users, but is not required at all for Delphi 3 usage.            }
  37. {                                                                              }
  38. {   There are some serious limitations that I did not realize when I first     }
  39. {    released the virtual mode feature.  If you are not using virtual mode     }
  40. {    (VirtualMode set to TRUE) then you need not be concerned.  These problems }
  41. {    only affect virutal mode.  The problem is that since items are not stored }
  42. {    by the list view, but rather provided as needed by an event handler, the  }
  43. {    Items property does not reflect the actual items in the list.  In fact,   }
  44. {    it is always empty.  Items.Count will return the proper number of items,  }
  45. {    but anything trying to use Items[x] will never get any valid data.  This  }
  46. {    affects several things, such as automatic drag and drop (DragMode =       }
  47. {    dmAutomatic), the Selected property and more.  This is because the        }
  48. {    implementation of TListView uses the Items property extensively. I have   }
  49. {    had some limited success in overriding the Items property and supplying   }
  50. {    my own methods for getting and setting TListItems for it, so I believe    }
  51. {    that I will eventually be able to corret this problem.  However, I do not }
  52. {    know when I will be able to get to it, so for now I suggest you not use   }
  53. {    virtual mode unless you completely understand all of the problems that    }
  54. {    may arise from it.                                                        }
  55. { -----------------------------------------------------------------------------}
  56. {                                                                              }
  57. { Revision History: (See History.txt for full list)                            }
  58. { 3.00:  Beta 1                                                                }
  59. {        + Initial Public Beta.                                                }
  60. {        + Added owner drawing.  Only the vsReport mode is owner draw.  Set    }
  61. {          Style to lvOwnerDrawFixed (there is no variable mode for the        }
  62. {          control) and add a handler for OnDrawItem.  Also, Setting           }
  63. {          DefaultOwnerDrawing to true will provide the basic drawing for you. }
  64. {        + Column headers can now use images from the SmallImages image list.  }
  65. {          See the ColumnsFormat property.                                     }
  66. {        + I'm never going to get the default sorting procedure to cover every }
  67. {          situation that people keep coming up with, so I did the smart thing:}
  68. {          OnSortItems event.  This is fired when AutoColumnSort <> acsNoSort  }
  69. {          and an event is assigned.  If not event is assigned, it sorts like  }
  70. {          it used to. The component takes care of reversing the order to      }
  71. {          account for descending when acsSortToggle is on.                    }
  72. { Beta 2 + Changed the default sorting routine so that it generates many fewer }
  73. {          exceptions when checking for a valid date.  This breaks sorting     }
  74. {          long dates (dates without a DateSeperator character in them)        }
  75. {          automatically, but that should be rare enough to warrant writing    }
  76. {          your own OnSortItems event handler for.  It's very annoying when    }
  77. {          you are trying to debug to have all these exceptions being thrown   }
  78. {          around. Thanks to Allan Harkness (allan@atheroma.prestel.co.uk) for }
  79. {          the suggestion.                                                     }
  80. {        + Added OnSortBegin and OnSortFinished events.  Bet you can guess     }
  81. {          when they get called...                                             }
  82. {        + Fixed nasty little column image bug. For some reason, the SECOND    }
  83. {          time you drag a header width, it toasts the bitmap. I think it has  }
  84. {          to do with the TListView class somehow resetting the column         }
  85. {          information, overwriting our information (image info).  Anyway,     }
  86. {          catching the condition (begin column header drag) and resetting all }
  87. {          the extended information for that column fixes it. See WMNotify     }
  88. {          method if you are interested.                                       }
  89. {        + Fixed another column image bug.  Didn't always like it when image   }
  90. {          was on the right of right-aligned text.                             }
  91. {        + Still have one problem, but it's only an issue if you don't know    }
  92. {          about it. Changing the alignment of a column (Columns[0].Alignment  }
  93. {          := taLeftJustify) will cause the column image to disappear.  It     }
  94. {          happens because TListView wipes out our extened information.        }
  95. {          Because of that, and because the method that does it is not virtual,}
  96. {          I can't force an update to reset the image information.  I'm hoping }
  97. {          I'll find a notification message that lets me know when something   }
  98. {          like this happens, but I can't find one so far. Anybody got any     }
  99. {          ideas?  For now, you'll just have to reset it yourself if you       }
  100. {          change any Columns information by calling UpdateColumnsImages or    }
  101. {          UpdateColumnImage(Index).                                           }
  102. { Beta 3 + Updated to work with Delphi 2.                                      }
  103. { Beta 4 + I goofed an $IFDEF in the last beta and broke the SaveSettings      }
  104. {          property, among other things.                                       }
  105. {        + Date sorting didn't work for folks who use '.' character as a date  }
  106. {          sepeartor.  It was being falsely identified as a valid number       }
  107. {          it could be identified as a date.  Changed the order so that dates  }
  108. {          are checked for before numbers.                                     }
  109. {        + Changing Style back and forth between standard and owner draw would }
  110. {          cause all sorts of nasty errors.  FCanvas was being freed but not   }
  111. {          reset to NIL after.                                                 }
  112. { Beta 5 + Broke all stuff that was not associated with the updated COMCTL32   }
  113. {          out into TEnhListView component.  Reasoning is twofold:  1) If you  }
  114. {          don't want to have to deal with the updated DLL, you can still have }
  115. {          some of the cool stuff like auto sorting and auto save settings,    }
  116. {          and 2) it reduces the complexity of the component, making it easier }
  117. {          (hopefully) for me to track down some of these nasty bugs.          }
  118. { Beta 6 + Did some more fiddling with things in an attempt to fix the nasty   }
  119. {          bug some people have related to the ExtendedStyles and/or Style     }
  120. {          and/or HideSelection properties.  Is that vague enough?  :)         }
  121. {        + Moved call to StoreSettings out of WM_DESTROY handler into          }
  122. {          destructor where it belongs.                                        }
  123. {        + Got rid of anything that even looked like it was assuming that      }
  124. {          Handle was valid. More desperation per item 1 above.                }
  125. {        + Conditionally removed all the stuff I was redeclaring when under    }
  126. {          Delphi 3.  I wrote this stuff before things like LVM_GETSUBITEMRECT }
  127. {          were declared in Borland's COMMCTRL.PAS file.  No since in my       }
  128. {          redeclaring them if you don't need them.                            }
  129. { Beta 7 + Stupid oversight.  Would not compile under Delphi 2.                }
  130. { Beta 8 + OnVMFindItem event declaration was wrong.  Found parameter should   }
  131. {          have been an integer: return -1 for not found, otherwise item index.}
  132. {        + Column sizes weren't being autosaved.                               }
  133. {------------------------------------------------------------------------------}
  134.  
  135.  
  136. unit ExtListView;
  137.  
  138. interface
  139.  
  140. {$IFNDEF WIN32}
  141.   ERROR!  This unit only available for Delphi 2.0 or higher!!!
  142. {$ENDIF}
  143.  
  144. uses
  145.   Windows, Messages, Classes, Controls, ComCtrls, CommCtrl, SysUtils, Graphics,
  146.   StdCtrls, Menus, EnhListView;
  147.  
  148.  
  149. type
  150.   TLVDispInfo = TLVDispInfoA; // Borland forgot this one.
  151.  
  152. const
  153.   LVIF_INDENT             = $0010;
  154.   LVIF_NORECOMPUTE        = $0800;
  155.  
  156. {$IFNDEF VER100}
  157.   LVCF_FMT                = $0001;
  158.   LVCF_WIDTH              = $0002;
  159.   LVCF_TEXT               = $0004;
  160.   LVCF_SUBITEM            = $0008;
  161. {$ENDIF}
  162.   LVCF_IMAGE              = $0010;
  163.   LVCF_ORDER              = $0020;
  164.  
  165. {$IFNDEF VER100}
  166.   LVCFMT_LEFT             = $0000;
  167.   LVCFMT_RIGHT            = $0001;
  168.   LVCFMT_CENTER           = $0002;
  169.   LVCFMT_JUSTIFYMASK      = $0003;
  170. {$ENDIF}
  171.   LVCFMT_IMAGE            = $0800; // Item displays an image from an image list.
  172.   LVCFMT_BITMAP_ON_RIGHT  = $1000; // Image appears to right of text.
  173.   LVCFMT_COL_HAS_IMAGES   = $8000; // Undocumented.
  174.  
  175.  
  176. type
  177.   PLVItemEx = ^TLVItemEx;
  178.   TLVItemEx = packed record
  179.     mask: UINT;
  180.     iItem: Integer;
  181.     iSubItem: Integer;
  182.     state: UINT;
  183.     stateMask: UINT;
  184.     pszText: PAnsiChar;
  185.     cchTextMax: Integer;
  186.     iImage: Integer;
  187.     lParam: LPARAM;
  188.     iIndent: integer;
  189.   end;
  190.  
  191.   PLVDispInfoEx = ^TLVDispInfoEx;
  192.   TLVDispInfoEx = packed record
  193.     hdr:   TNMHDR;
  194.     item:  TLVItemEx;
  195.   end;
  196.  
  197. type
  198.   TLVColumnEx = packed record
  199.     mask: UINT;
  200.     fmt: Integer;
  201.     cx: Integer;
  202.     pszText: PAnsiChar;
  203.     cchTextMax: Integer;
  204.     iSubItem: Integer;
  205.     iImage: integer; // New
  206.     iOrder: integer; // New
  207.   end;
  208.  
  209.  
  210. // These functions already exist, and there is no way to override them, so I'll just
  211. // rename them and you can use them as best you can.
  212. function ListView_GetColumnEx(LVWnd: HWND; iCol: Integer; var pcol: TLVColumnEx): Bool;
  213. function ListView_SetColumnEx(LVWnd: HWnd; iCol: Integer; const pcol: TLVColumnEx): Bool;
  214. function ListView_InsertColumnEx(LVWnd: HWND; iCol: Integer;
  215.                                  const pcol: TLVColumnEx): Integer;
  216.  
  217.  
  218. { I think this one may work for TEnhListView, but I'm not sure.  Need to check }
  219. const
  220.   LVM_GETHEADER           = LVM_FIRST + 31;
  221.  
  222. function ListView_GetHeader(LVWnd: HWnd): HWnd;
  223.  
  224. {$IFNDEF VER100}
  225. const
  226.   LVM_SETICONSPACING      = LVM_FIRST + 53;
  227.  
  228.   // -1 for cx and cy means we'll use the default (system settings)
  229.   // 0 for cx or cy means use the current setting (allows you to change just one param)
  230. function ListView_SetIconSpacing(LVWnd: HWnd; cx, cy: integer): DWORD;
  231.  
  232. const
  233.   LVS_EX_GRIDLINES             = $00000001;  // Report mode only.
  234.   LVS_EX_SUBITEMIMAGES         = $00000002;  // Report mode only.
  235.   LVS_EX_CHECKBOXES            = $00000004;
  236.   LVS_EX_TRACKSELECT           = $00000008;
  237.   LVS_EX_HEADERDRAGDROP        = $00000010;  // Report mode only.
  238.   LVS_EX_FULLROWSELECT         = $00000020;  // Report mode only.
  239.   LVS_EX_ONECLICKACTIVATE      = $00000040;
  240.   LVS_EX_TWOCLICKACTIVATE      = $00000080;
  241.  
  242.   LVM_SETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 54;
  243.  
  244. function ListView_SetExtendedListViewStyle(LVWnd: HWnd; ExStyle: LPARAM): DWORD;
  245.  
  246. const
  247.   LVM_GETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 55;
  248.  
  249. function ListView_GetExtendedListViewStyle(LVWnd: HWnd): DWORD;
  250.  
  251. const
  252.   LVIR_BOUNDS             = 0;
  253.   LVIR_ICON               = 1;
  254.   LVIR_LABEL              = 2;
  255.   LVIR_SELECTBOUNDS       = 3;
  256.  
  257.   LVM_GETSUBITEMRECT      = LVM_FIRST + 56;
  258.  
  259. function ListView_GetSubItemRect(LVWnd: HWnd; ParentItem, SubItem, Code: integer;
  260.                                  var Rect: TRect): boolean;
  261.  
  262. const
  263.   LVM_SUBITEMHITTEST      = LVM_FIRST + 57;
  264. {$ENDIF}
  265.  
  266. type
  267.   PLVHitTestInfoEx = ^TLVHitTestInfoEx;
  268.   TLVHitTestInfoEx = packed record
  269.     pt: TPoint;
  270.     flags: UINT;
  271.     iItem: integer;
  272.     iSubItem: integer;
  273.   end;
  274.  
  275. {$IFNDEF VER100}
  276. function ListView_SubItemHitTest(LVWnd: HWnd; var HitTestInfo: TLVHitTestInfoEx): integer;
  277.  
  278. const
  279.   LVM_SETCOLUMNORDERARRAY = LVM_FIRST + 58;
  280.  
  281. function ListView_SetColumnOrderArray(LVWnd: HWnd; Count: integer;
  282.                                       IntArray: PIntArray): boolean;
  283.  
  284. const
  285.   LVM_GETCOLUMNORDERARRAY = LVM_FIRST + 59;
  286.  
  287. function ListView_GetColumnOrderArray(LVWnd: HWnd; Count: integer;
  288.                                       IntArray: PIntArray): boolean;
  289.  
  290. const
  291.   LVM_SETHOTITEM  = LVM_FIRST + 60;
  292.  
  293. function ListView_SetHotItem(LVWnd: HWnd; Item: integer): integer;
  294.  
  295. const
  296.   LVM_GETHOTITEM  = LVM_FIRST + 61;
  297.  
  298. function ListView_GetHotItem(LVWnd: HWnd): integer;
  299.  
  300. const
  301.   LVM_SETHOTCURSOR  = LVM_FIRST + 62;
  302.  
  303. function ListView_SetHotCursor(LVWnd: HWnd; Cursor: HCursor): HCursor;
  304.  
  305. const
  306.   LVM_GETHOTCURSOR  = LVM_FIRST + 63;
  307.  
  308. function ListView_GetHotCursor(LVWnd: HWnd): HCursor;
  309.  
  310. const
  311.   LVM_APPROXIMATEVIEWRECT = LVM_FIRST + 64;
  312.  
  313. function ListView_ApproximateViewRect(LVWnd: HWnd; Width, Height, Count: integer): DWORD;
  314.  
  315. const
  316.   LVM_SETWORKAREA         = LVM_FIRST + 65;
  317.  
  318. function ListView_SetWorkArea(LVWnd: HWnd; const Rect: TRect): boolean;
  319.  
  320. function ListView_GetCheckState(LVWnd: HWnd; Index: UINT): boolean;
  321.  
  322. procedure ListView_SetCheckState(LVWnd: HWnd; Index: UINT; Checked: boolean);
  323. {$ENDIF}
  324.  
  325. const
  326.   LVSICF_NOINVALIDATEALL  = $00000001;
  327.   LVSICF_NOSCROLL         = $00000002;
  328.  
  329. procedure ListView_SetItemCountEx(LVWnd: HWnd; Items: integer; Flags: DWORD);
  330.  
  331. const
  332. {$IFNDEF VER100}
  333.   { New list view style flags.                                                           }
  334.   LVS_OWNERDATA                = $1000; // Specifies a "virtual" list veiw control.
  335.  
  336.   { New notification messages.                                                           }
  337.   LVN_ODCACHEHINT              = LVN_FIRST-13;
  338.   LVN_ODFINDITEMA              = LVN_FIRST-52;
  339.   LVN_ODFINDITEMW              = LVN_FIRST-79;
  340.   LVN_ODFINDITEM               = LVN_ODFINDITEMA;
  341. {$ENDIF}
  342.  
  343.   LVN_ITEMACTIVATE             = LVN_FIRST-14;
  344.   LVN_ODSTATECHANGED           = LVN_FIRST-15;
  345.   LVN_MARQUEEBEGIN             = LVN_FIRST-56;
  346.  
  347. type
  348. {$IFNDEF VER100}
  349.   PNMCacheHint = ^TNMCacheHint;
  350.   TNMCacheHint = packed record
  351.     hdr:       TNMHDR;
  352.     iFrom:     integer;
  353.     iTo:       integer;
  354.   end;
  355.  
  356.   PNMFindItem = ^TNMFindItem;
  357.   TNMFindItem = packed record
  358.     hdr:       TNMHDR;
  359.     iStart:    integer;
  360.     lvif:      TLVFindInfo;
  361.   end;
  362. {$ENDIF}
  363.  
  364.   PNMODStateChange = ^TNMODStateChange;
  365.   TNMODStateChange = packed record
  366.     hdr:       TNMHDR;
  367.     iFrom:     integer;
  368.     iTo:       integer;
  369.     uNewState: UINT;
  370.     uOldState: UINT;
  371.   end;
  372.  
  373.  
  374. type
  375.   { New extended style flags converted to set format.                                    }
  376.   {   lvxGridlines: Adds grid lines to seperate items and columns. Report mode only.     }
  377.   {   lvxSubItemImages: Allows images to be displayed for subitems.  Report mode only.   }
  378.   {   lvxCheckboxes: Adds checkboxes to items.  Checked items are stored internally as   }
  379.   {       selected items.                                                                }
  380.   {   lvxTrackSelect: Tracks the mouse and highlights the item it currently positioned   }
  381.   {       over by changing it's color.  If mouse is left over an item for a brief period }
  382.   {       of time, it will be automatically selected.                                    }
  383.   {   lvxHeaderDragDrop: Allows headers to be dragged to new positions and dropped,      }
  384.   {       allowing users to reorder column information.                                  }
  385.   {   lvxFullRowSelect: Allows user to click anywhere on an item to select it,           }
  386.   {       highlighting the entire length of the item.  Without this style, users must    }
  387.   {       click inside the text of column 0.  It is only useful in vsReport view style.  }
  388.   {   lvxOneClickActivate: Sends an LVN_ITEMACTIVATE notification message to the parent  }
  389.   {       when the user clicks an item.                                                  }
  390.   {   lvxTwoClickActivate: Sends an LVN_ITEMACTIVATE notification message to the parent  }
  391.   {       when the user double clicks an item.                                           }
  392.   TLVExtendedStyle = (lvxGridLines, lvxSubItemImages, lvxCheckboxes, lvxTrackSelect,
  393.                       lvxHeaderDragDrop, lvxFullRowSelect, lvxOneClickActivate,
  394.                       lvxTwoClickActivate);
  395.  
  396.   { A set of the new style bits.                                                         }
  397.   TLVExtendedStyles = set of TLVExtendedStyle;
  398.  
  399.   TLVItemCountFlag = (lvsicfNoInvalidateAll, lvsicfNoScroll);
  400.   TLVItemCountFlags = set of TLVItemCountFlag;
  401.  
  402.   TLVVMMaskItem = (lvifText, lvifImage, lvifParam, lvifState, lvifIndent);
  403.   TLVVMMaskItems = set of TLVVMMaskItem;
  404.  
  405.   TColumnImageAlign = (ciaLeftOfText, ciaRightOfText);
  406.  
  407.   TLVMarqueeBeginEvent   = procedure(Sender: TObject; var CanBegin: boolean) of object;
  408.   TLVItemActivateEvent   = TNotifyEvent;
  409.  
  410.   TLVVMGetItemInfoEvent  = procedure(Sender: TObject; Item, SubItem: integer;
  411.                                      Mask: TLVVMMaskItems; var Image: integer;
  412.                                      var Param: LPARAM; var State: UINT;
  413.                                      var Indent: integer; var Text: string) of object;
  414.   TLVVMCacheHintEvent    = procedure(Sender: TObject; var HintInfo: TNMCacheHint) of object;
  415.   TLVVMFindItemEvent     = procedure(Sender: TObject; var FindInfo: TNMFindItem;
  416.                                      var Found: integer) of object;
  417.   TLVVMStateChangedEvent = procedure(Sender: TObject; var StateInfo: TNMODStateChange) of object;
  418.  
  419.   { Class for saved settings                                                             }
  420.   TExtLVSaveSettings = class(TEnhLVSaveSettings)
  421.   private
  422.     FSaveColumnOrder: boolean;
  423.   public
  424.     constructor Create; override;
  425.     procedure StoreColumnOrder(ColCount: integer; const IntArray: array of integer);
  426.     procedure ReadColumnOrder(ColCount: integer; var IntArray: array of integer);
  427.   published
  428.     property SaveColumnOrder: boolean read FSaveColumnOrder write FSaveColumnOrder default TRUE;
  429.   end;
  430.  
  431.   TExtListView = class; { forward declaration }
  432.  
  433.   TExtListColumn = class(TCollectionItem)
  434.   private
  435.     FSmallImageIndex: Integer;
  436.     FImageAlignment : TColumnImageAlign;
  437.     procedure DoChange;
  438.     procedure SetSmallImageIndex(Value: Integer);
  439.     procedure SetImageAlignment(Value: TColumnImageAlign);
  440.   public
  441.     constructor Create(Collection: TCollection); override;
  442.     destructor Destroy; override;
  443.     procedure Assign(Source: TPersistent); override;
  444.   published
  445.     property ImageIndex: integer
  446.              read FSmallImageIndex write SetSmallImageIndex default -1;
  447.     property ImageAlignment: TColumnImageAlign
  448.              read FImageAlignment write SetImageAlignment default ciaRightOfText;
  449.   end;
  450.  
  451.   TExtListColumns = class(TCollection)
  452.   private
  453.     FOwner: TExtListView;
  454.     function GetItem(Index: Integer): TExtListColumn;
  455.     procedure SetItem(Index: Integer; Value: TExtListColumn);
  456.   protected
  457.     function GetOwner: TPersistent; {$IFDEF VER100} override; {$ENDIF}
  458.     procedure Update(Item: TCollectionItem); override;
  459.   public
  460.     constructor Create(AOwner: TExtListView);
  461.     procedure Assign(Source: TPersistent); override;
  462.     function Add: TExtListColumn;
  463.     procedure Refresh;
  464.     property Owner: TExtListView read FOwner;
  465.     property Items[Index: Integer]: TExtListColumn read GetItem write SetItem; default;
  466.   end;
  467.  
  468.   { The new class.                                                                       }
  469.   TExtListView = class(TCustomEnhListView)
  470.   private
  471.     FExtendedStyles: TLVExtendedStyles;
  472.     FColumnOrder: PIntArray;
  473.     FColumnOrderCount: integer;
  474.     FColumnsFormat: TExtListColumns;
  475.     FVirtualMode: boolean;
  476.     FSaveSettings: TExtLVSaveSettings;
  477.     FColumnsFormatChangeLink: TChangeLink;
  478.  
  479.     FOnMarqueeBegin: TLVMarqueeBeginEvent;
  480.     FOnItemActivate: TLVItemActivateEvent;
  481.     FOnVMGetItemInfo: TLVVMGetItemInfoEvent;
  482.     FOnVMCacheHint: TLVVMCacheHintEvent;
  483.     FOnVMFindItem: TLVVMFindItemEvent;
  484.     FOnVMStateChanged: TLVVMStateChangedEvent;
  485.  
  486.     { Function to convert from our set type to expected API value.                       }
  487.     function SetValueToAPIValue(Styles: TLVExtendedStyles): LPARAM;
  488.     function SetValueFromAPIValue(Styles: DWORD): TLVExtendedStyles;
  489.  
  490.     procedure ColumnHeaderImagesChange(Sender: TObject);
  491.  
  492.     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  493.     procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
  494.   protected
  495.     { Property method for setting styles.                                                }
  496.     procedure SetExtendedStyles(Val: TLVExtendedStyles);
  497.     function GetExtendedStyles: TLVExtendedStyles;
  498.     function GetHeaderHandle: HWnd;
  499.     function GetSubItemRect(Item, SubItem: integer; Index: integer): TRect;
  500.     procedure SetHotItem(Val: integer);
  501.     function GetHotItem: integer;
  502.     procedure SetHotCursor(const Val: HCursor);
  503.     function GetHotCursor: HCursor;
  504.     procedure SetWorkArea(Rect: TRect);
  505.     procedure SetCheckState(Index: integer; Checked: boolean);
  506.     function GetCheckState(Index: integer): boolean;
  507.     procedure SetVirtualMode(Val: boolean);
  508.     procedure SetColumnsFormat(Value: TExtListColumns);
  509.  
  510.     procedure CreateParams(var Params: TCreateParams); override;
  511.     procedure CreateWnd; override;
  512.     procedure DestroyWnd; override;
  513.     procedure Loaded; override;
  514.     { Event method handlers -- fire the events if they exist.                            }
  515.     function MarqueeBegin: boolean; virtual;
  516.     procedure ItemActivate; virtual;
  517.     procedure VMGetDispInfo(var ItemInfo: TLVItemEx); virtual;
  518.     procedure VMCacheHint(var HintInfo: TNMCacheHint); virtual;
  519.     function VMFindItem(var FindInfo: TNMFindItem): integer; virtual;
  520.     procedure VMStateChanged(var StateInfo: TNMODStateChange); virtual;
  521.   public
  522.     constructor Create(AOwner: TComponent); override;
  523.     destructor Destroy; override;
  524.  
  525.     { Force reset of column image information }
  526.     procedure UpdateColumnsImages;
  527.     procedure UpdateColumnImage(Index: integer);
  528.  
  529.     procedure SetIconSpacing(X, Y: integer);
  530.     function GetSubItemAt(X, Y: integer): string;
  531.     procedure SetColumnOrder(Count: integer; const IntArray: array of integer);
  532.     function GetColumnOrder(Count: integer; var IntArray: array of integer): boolean;
  533.     function ApproximateViewRect(Count: integer; const Proposed: TPoint): TPoint;
  534.     procedure SetItemCountEx(Count: integer; Flags: TLVItemCountFlags);
  535.     procedure StoreSettings; override;
  536.     procedure LoadSettings; override;
  537.  
  538.     property HeaderHandle: HWnd
  539.              read GetHeaderHandle;
  540.     property SubItem_BoundsRect[Item: integer; SubItem: integer]: TRect
  541.              index LVIR_BOUNDS
  542.              read GetSubItemRect;
  543.     property SubItem_IconRect[Item: integer; SubItem: integer]: TRect
  544.              index LVIR_ICON
  545.              read GetSubItemRect;
  546.     property SubItem_LabelRect[Item: integer; SubItem: integer]: TRect
  547.              index LVIR_LABEL
  548.              read GetSubItemRect;
  549.     property SubItem_SelectBoundsRect[Item: integer; SubItem: integer]: TRect
  550.              index LVIR_SELECTBOUNDS
  551.              read GetSubItemRect;
  552.     property HotItem: integer
  553.              read GetHotItem write SetHotItem;
  554.     property HotCursor: HCursor
  555.              read GetHotCursor write SetHotCursor;
  556.     property WorkArea: TRect
  557.              write SetWorkArea;
  558.     property IsChecked[Index: integer]: boolean
  559.              read GetCheckState write SetCheckState;
  560.   published
  561.     { I moved these to try to fix a really strange bug.  Danny Crone says it works for him }
  562.     property Columns;
  563.     property HideSelection;
  564.  
  565.     { Property for new styles.                                                           }
  566.     property ExtendedStyles: TLVExtendedStyles
  567.              read GetExtendedStyles write SetExtendedStyles default [];
  568.     property VirtualMode: boolean
  569.              read FVirtualMode write SetVirtualMode default FALSE;
  570.  
  571.     { Autosave settings property.                                                        }
  572.     property SaveSettings: TExtLVSaveSettings
  573.              read FSaveSettings write FSaveSettings;
  574.  
  575.     property ColumnsFormat: TExtListColumns
  576.              read FColumnsFormat write SetColumnsFormat;
  577.  
  578.    { Events                                                                             }
  579.     property OnMarqueeBegin: TLVMarqueeBeginEvent
  580.              read FOnMarqueeBegin write FOnMarqueeBegin;
  581.     property OnItemActivate: TLVItemActivateEvent
  582.              read FOnItemActivate write FOnItemActivate;
  583.     property OnVMGetItemInfo: TLVVMGetItemInfoEvent
  584.              read FOnVMGetItemInfo write FOnVMGetItemInfo;
  585.     property OnVMCacheHint: TLVVMCacheHintEvent
  586.              read FOnVMCacheHint write FOnVMCacheHint;
  587.     property OnVMFindItem: TLVVMFindItemEvent
  588.              read FOnVMFindItem write FOnVMFindItem;
  589.     property OnVMStateChanged: TLVVMStateChangedEvent
  590.              read FOnVMStateChanged write FOnVMStateChanged;
  591.  
  592.     { Publish inherited protected properties }
  593.     property AutoColumnSort;
  594.     property AutoSortAscending;
  595.     property CurrentSortAscending;
  596.     property Style;
  597.  
  598.     property OnDrawItem;
  599.     property OnAfterDefaultDrawItem;
  600.     property OnSortItems;
  601.     property OnSortBegin;
  602.     property OnSortFinished;
  603.  
  604.  
  605.     property Align;
  606.     property BorderStyle;
  607.     property Color;
  608.     property ColumnClick;
  609.     property OnClick;
  610.     property OnDblClick;
  611.     property Ctl3D;
  612.     property DragMode;
  613.     property ReadOnly default False;
  614.     property Enabled;
  615.     property Font;
  616.     property IconOptions;
  617.     property Items;
  618.     property AllocBy;
  619.     property MultiSelect;
  620.     property OnChange;
  621.     property OnChanging;
  622.     property OnColumnClick;
  623.     property OnCompare;
  624.     property OnDeletion;
  625.     property OnEdited;
  626.     property OnEditing;
  627.     property OnEnter;
  628.     property OnExit;
  629.     property OnInsert;
  630.     property OnDragDrop;
  631.     property OnDragOver;
  632.     property DragCursor;
  633.     property OnStartDrag;
  634.     property OnEndDrag;
  635.     property OnMouseDown;
  636.     property OnMouseMove;
  637.     property OnMouseUp;
  638.     property ParentColor default False;
  639.     property ParentFont;
  640.     property ParentShowHint;
  641.     property ShowHint;
  642.     property PopupMenu;
  643.     property ShowColumnHeaders;
  644.     property SortType;
  645.     property TabOrder;
  646.     property TabStop default True;
  647.     property ViewStyle;
  648.     property Visible;
  649.     property OnKeyDown;
  650.     property OnKeyPress;
  651.     property OnKeyUp;
  652.     property LargeImages;
  653.     property SmallImages;
  654.     property StateImages;
  655.   end;
  656.  
  657.  
  658. implementation
  659.  
  660. uses
  661. {$IFDEF VER90}
  662.   ExtColEd,
  663. {$ENDIF}
  664.   Registry;
  665.  
  666.  
  667. function ListView_GetColumnEx(LVWnd: HWND; iCol: Integer; var pcol: TLVColumnEx): bool;
  668. begin
  669.   Result := bool(SendMessage(LVWnd, LVM_GETCOLUMN, iCol, LPARAM(@pcol)));
  670. end;
  671.  
  672. function ListView_SetColumnEx(LVWnd: HWnd; iCol: Integer; const pcol: TLVColumnEx): Bool;
  673. begin
  674.   Result := bool(SendMessage(LVWnd, LVM_SETCOLUMN, iCol, Longint(@pcol)));
  675. end;
  676.  
  677. function ListView_InsertColumnEx(LVWnd: HWND; iCol: Integer;
  678.                                  const pcol: TLVColumnEx): Integer;
  679. begin
  680.   Result := SendMessage(LVWnd, LVM_INSERTCOLUMN, iCol, Longint(@pcol));
  681. end;
  682.  
  683. function ListView_GetHeader(LVWnd: HWnd): HWnd;
  684. begin
  685.   Result := HWnd(SendMessage(LVWnd, LVM_GETHEADER, 0, 0));
  686. end;
  687.  
  688. function ListView_SetIconSpacing(LVWnd: HWnd; cx, cy: integer): DWORD;
  689. begin
  690.   Result := SendMessage(LVWnd, LVM_SETICONSPACING, 0, MAKELONG(cx,cy));
  691. end;
  692.  
  693. function ListView_SetExtendedListViewStyle(LVWnd: HWnd; ExStyle: LPARAM): DWORD;
  694. begin
  695.   Result := SendMessage(LVWnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, ExStyle);
  696. end;
  697.  
  698. function ListView_GetExtendedListViewStyle(LVWnd: HWnd): DWORD;
  699. begin
  700.   Result := SendMessage(LVWnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0);
  701. end;
  702.  
  703. function ListView_GetSubItemRect(LVWnd: HWnd; ParentItem, SubItem, Code: integer;
  704.                                  var Rect: TRect): boolean;
  705. begin
  706.   Rect.Top := SubItem;
  707.   Rect.Left := Code;
  708.   Result := (SendMessage(LVWnd, LVM_GETSUBITEMRECT, ParentItem, LPARAM(@Rect)) <> 0);
  709. end;
  710.  
  711. function ListView_SubItemHitTest(LVWnd: HWnd; var HitTestInfo: TLVHitTestInfoEx): integer;
  712. begin
  713.   Result := SendMessage(LVWnd, LVM_SUBITEMHITTEST, 0, LPARAM(@HitTestInfo));
  714. end;
  715.  
  716. function ListView_SetColumnOrderArray(LVWnd: HWnd; Count: integer;
  717.                                       IntArray: PIntArray): boolean;
  718. begin
  719.   Result := (SendMessage(LVWnd, LVM_SETCOLUMNORDERARRAY, Count, LPARAM(IntArray)) <> 0);
  720. end;
  721.  
  722. function ListView_GetColumnOrderArray(LVWnd: HWnd; Count: integer;
  723.                                       IntArray: PIntArray): boolean;
  724. begin
  725.   Result := (SendMessage(LVWnd, LVM_GETCOLUMNORDERARRAY, Count, LPARAM(IntArray)) <> 0);
  726. end;
  727.  
  728. function ListView_SetHotItem(LVWnd: HWnd; Item: integer): integer;
  729. begin
  730.   Result := SendMessage(LVWnd, LVM_SETHOTITEM, Item, 0);
  731. end;
  732.  
  733. function ListView_GetHotItem(LVWnd: HWnd): integer;
  734. begin
  735.   Result := SendMessage(LVWnd, LVM_GETHOTITEM, 0, 0);
  736. end;
  737.  
  738. function ListView_SetHotCursor(LVWnd: HWnd; Cursor: HCursor): HCursor;
  739. begin
  740.   Result := HCursor(SendMessage(LVWnd, LVM_SETHOTCURSOR, 0, LPARAM(Cursor)));
  741. end;
  742.  
  743. function ListView_GetHotCursor(LVWnd: HWnd): HCursor;
  744. begin
  745.   Result := HCursor(SendMessage(LVWnd, LVM_GETHOTCURSOR, 0, 0));
  746. end;
  747.  
  748. function ListView_ApproximateViewRect(LVWnd: HWnd; Width, Height, Count: integer): DWORD;
  749. begin
  750.   Result := SendMessage(LVWnd, LVM_APPROXIMATEVIEWRECT, Count, MAKELPARAM(Width, Height));
  751. end;
  752.  
  753. function ListView_SetWorkArea(LVWnd: HWnd; const Rect: TRect): boolean;
  754. begin
  755.   Result := (SendMessage(LVWnd, LVM_SETWORKAREA, 0, LPARAM(@Rect)) <> 0);
  756. end;
  757.  
  758. function ListView_GetCheckState(LVWnd: HWnd; Index: UINT): boolean;
  759. begin
  760.   Result := (SendMessage(LVWnd, LVM_GETITEMSTATE, Index, LVIS_STATEIMAGEMASK) SHR 12)-1 <> 0;
  761. end;
  762.  
  763. procedure ListView_SetCheckState(LVWnd: HWnd; Index: UINT; Checked: boolean);
  764. const
  765.   LVIS_UNCHECKED = $1000;
  766.   LVIS_CHECKED = $2000;
  767. var
  768.   Data: integer;
  769. begin
  770.   if Checked then Data := LVIS_CHECKED
  771.   else Data := LVIS_UNCHECKED;
  772.   ListView_SetItemState(LVWnd, Index, Data, LVIS_STATEIMAGEMASK);
  773. end;
  774.  
  775. procedure ListView_SetItemCountEx(LVWnd: HWnd; Items: integer; Flags: DWORD);
  776. begin
  777.   SendMessage(LVWnd, LVM_SETITEMCOUNT, Items, Flags);
  778. end;
  779.  
  780.  
  781. constructor TExtLVSaveSettings.Create;
  782. begin
  783.   inherited Create;
  784.   FSaveColumnOrder := TRUE;
  785. end;
  786.  
  787. procedure TExtLVSaveSettings.StoreColumnOrder(ColCount: integer; const IntArray: array of integer);
  788. var
  789.   Reg: TRegIniFile;
  790.   x: integer;
  791.   s: string;
  792. begin
  793.   if ColCount < 1 then exit;
  794.   s := '';
  795.   for x := 0 to ColCount-1 do
  796.     s := s + IntToStr(IntArray[x]) + ',';
  797.   SetLength(s, Length(s)-1);
  798.   Reg := TRegIniFile.Create(RegistryKey);
  799.   try
  800.     Reg.WriteString('Columns', 'Order', s);
  801.   finally
  802.     Reg.Free;
  803.   end;
  804. end;
  805.  
  806. procedure TExtLVSaveSettings.ReadColumnOrder(ColCount: integer; var IntArray: array of integer);
  807. var
  808.   Reg: TRegIniFile;
  809.   x,y: integer;
  810.   s: string;
  811. begin
  812.   if ColCount < 1 then exit;
  813.   s := '';
  814.   Reg := TRegIniFile.Create(RegistryKey);
  815.   try
  816.     s := Reg.ReadString('Columns', 'Order', '');
  817.   finally
  818.     Reg.Free;
  819.   end;
  820.   if s = '' then begin
  821.     for x := 0 to ColCount-1 do
  822.       IntArray[x] := x;
  823.     exit;
  824.   end;
  825.   y := 0;
  826.   for x := 0 to ColCount-1 do begin
  827.     try
  828.       y := Pos(',', s);
  829.       if y = 0 then
  830.         y := Length(s)+1;
  831.       IntArray[x] := StrToInt(Copy(s, 1, y-1));
  832.     except
  833.       IntArray[x] := 0;
  834.     end;
  835.     s := copy(s, y+1, length(s));
  836.     if s = '' then break;
  837.   end;
  838. end;
  839.  
  840.  
  841. { Override constructor to "zero out" our internal variable.                              }
  842. constructor TExtListView.Create(AOwner: TComponent);
  843. begin
  844.   inherited Create(AOwner);
  845.   FExtendedStyles := [];
  846.   FColumnOrder := NIL;
  847.   FColumnOrderCount := 0;
  848.   FSaveSettings := TExtLVSaveSettings.Create;
  849.   FColumnsFormatChangeLink := TChangeLink.Create;
  850.   FColumnsFormatChangeLink.OnChange := ColumnHeaderImagesChange;
  851.   FVirtualMode := FALSE;
  852.   FColumnsFormat := TExtListColumns.Create(Self);
  853. //  FColumnHeaderImages := NIL;
  854. end;
  855.  
  856. destructor TExtListView.Destroy;
  857. begin
  858.   if FColumnOrder <> NIL then
  859.     FreeMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
  860.   FColumnsFormat.Free; { don't think i need this, it has an Owner property }
  861. //  FColumnsFormatChangeLink.Free;
  862.   inherited Destroy;
  863.   { Free after inherited because inherited calls StoreSettings which uses it...}
  864.   FSaveSettings.Free;
  865. end;
  866.  
  867. procedure TExtListView.CreateParams(var Params: TCreateParams);
  868. begin
  869.   inherited CreateParams(Params);
  870.  
  871.   if FVirtualMode then
  872.     Params.Style := Params.Style or LVS_OWNERDATA;
  873. end;
  874.  
  875. procedure TExtListView.CreateWnd;
  876. begin
  877.   inherited CreateWnd;
  878.  
  879.   SetExtendedStyles(FExtendedStyles);
  880.   if FColumnOrder <> NIL then
  881.   begin
  882.     SendMessage(Handle, LVM_SETCOLUMNORDERARRAY, FColumnOrderCount, LongInt(FColumnOrder));
  883.     Refresh;
  884.   end;
  885. end;
  886.  
  887. procedure TExtListView.DestroyWnd;
  888. begin
  889.   if FColumnOrder <> NIL then
  890.     FreeMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
  891.   FColumnOrderCount := Columns.Count;
  892.   GetMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
  893.   SendMessage(Handle, LVM_GETCOLUMNORDERARRAY, FColumnOrderCount,
  894.      LPARAM(FColumnOrder));
  895.  
  896.   inherited DestroyWnd;
  897. end;
  898.  
  899. procedure TExtListView.Loaded;
  900. begin
  901.   inherited Loaded;
  902.   LoadSettings;
  903.   UpdateColumnsImages;
  904. end;
  905.  
  906. const
  907.   API_STYLES: array[lvxGridLines..lvxTwoClickActivate] of LPARAM = (
  908.               LVS_EX_GRIDLINES, LVS_EX_SUBITEMIMAGES, LVS_EX_CHECKBOXES,
  909.               LVS_EX_TRACKSELECT, LVS_EX_HEADERDRAGDROP, LVS_EX_FULLROWSELECT,
  910.               LVS_EX_ONECLICKACTIVATE, LVS_EX_TWOCLICKACTIVATE
  911.               );
  912.  
  913. { Function to convert our style set type into the value expected by the API.             }
  914. function TExtListView.SetValueToAPIValue(Styles: TLVExtendedStyles): LPARAM;
  915. var
  916.   x: TLVExtendedStyle;
  917. begin
  918.   Result := 0;
  919.   { Check for each possible style. }
  920.   for x := lvxGridLines to lvxTwoClickActivate do
  921.     { If the style is set... }
  922.     if x in Styles then
  923.       { OR the appropriate value into the result. }
  924.       Result := Result OR API_STYLES[x];
  925. end;
  926.  
  927. { Function to convert from the API values to our style set type.                         }
  928. function TExtListView.SetValueFromAPIValue(Styles: DWORD): TLVExtendedStyles;
  929. var
  930.   x: TLVExtendedStyle;
  931. begin
  932.   Result := [];
  933.   { Check for each possible style. }
  934.   for x := lvxGridLines to lvxTwoClickActivate do
  935.     { If the style is set... }
  936.     if (API_STYLES[x] and Styles) <> 0 then
  937.       { OR the appropriate value into the result. }
  938.       Result := Result + [x];
  939. end;
  940.  
  941. { Property method to get the extended style bits.                                        }
  942. function TExtListView.GetExtendedStyles: TLVExtendedStyles;
  943. begin
  944.   if HandleAllocated then
  945.     FExtendedStyles := SetValueFromAPIValue(ListView_GetExtendedListViewStyle(Handle));
  946.   Result := FExtendedStyles;
  947. end;
  948.  
  949. { Property method to set new style bits.                                                 }
  950. procedure TExtListView.SetExtendedStyles(Val: TLVExtendedStyles);
  951. begin
  952.   { Update the window with the new styles. }
  953.   FExtendedStyles := Val;
  954.   if HandleAllocated then
  955.     ListView_SetExtendedListViewStyle(Handle, SetValueToAPIValue(Val));
  956. end;
  957.  
  958. function TExtListView.GetHeaderHandle: HWnd;
  959. begin
  960.   if HandleAllocated then
  961.     Result := ListView_GetHeader(Handle)
  962.   else
  963.     Result := 0;
  964. end;
  965.  
  966. { Not sure about how to update the view after changing this.  Refresh doesn't do the job.
  967.   Seems the best way to do it is something like:
  968.  
  969.   SetIconSpacing(X, Y);
  970.   if ViewStyle = vsIcon then begin
  971.     SendMessage(Handle, WM_SETREDRAW, 0, 0);
  972.     try
  973.       ViewStyle := vsSmallIcon;
  974.       ViewStyle := vsIcon;
  975.     finally
  976.       SendMessage(Handle, WM_SETREDRAW, 1, 0);
  977.     end;
  978.   end;
  979.  
  980. Does strange things if ViewStyle is not set to vsIcon!
  981. }
  982. procedure TExtListView.SetIconSpacing(X, Y: integer);
  983. begin
  984.   if HandleAllocated then
  985.     if ViewStyle = vsIcon then
  986.       ListView_SetIconSpacing(Handle, X, Y);
  987. end;
  988.  
  989. function TExtListView.GetSubItemRect(Item, SubItem: integer; Index: integer): TRect;
  990. begin
  991.   if HandleAllocated then
  992.     ListView_GetSubItemRect(Handle, Item, SubItem, Index, Result);
  993. end;
  994.  
  995. function TExtListView.GetSubItemAt(X, Y: integer): string;
  996. var
  997.   Info: TLVHitTestInfoEx;
  998. begin
  999.   Result := '';
  1000.   if HandleAllocated then
  1001.   begin
  1002.     Info.pt := Point(X, Y);
  1003.     if ListView_SubItemHitTest(Handle, Info) <> -1 then begin
  1004.       if Info.iItem > -1 then
  1005.         if Info.iSubItem = 0 then
  1006.           Result := Items[Info.iItem].Caption
  1007.         else
  1008.           Result := Items[Info.iItem].SubItems[Info.iSubItem-1];
  1009.     end;
  1010.   end;
  1011. end;
  1012.  
  1013. procedure TExtListView.SetColumnOrder(Count: integer; const IntArray: array of integer);
  1014. begin
  1015.   if FColumnOrder <> NIL then
  1016.     FreeMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
  1017.   FColumnOrderCount := Count;
  1018.   GetMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
  1019.   Move(IntArray, FColumnOrder^, FColumnOrderCount * SizeOf(Integer));
  1020.   if HandleAllocated then
  1021.   begin
  1022.     ListView_SetColumnOrderArray(Handle, Count, @IntArray);
  1023.     Refresh;
  1024.   end;
  1025. end;
  1026.  
  1027. function TExtListView.GetColumnOrder(Count: integer;
  1028.                                      var IntArray: array of integer): boolean;
  1029. begin
  1030.   if HandleAllocated then
  1031.   begin
  1032.     if Count <> FColumnOrderCount then
  1033.     begin
  1034.       FColumnOrderCount := Count;
  1035.       if FColumnOrder <> NIL then
  1036.         FreeMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
  1037.       GetMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
  1038.     end;
  1039.     Result := ListView_GetColumnOrderArray(Handle, FColumnOrderCount, @IntArray);
  1040.     Move(IntArray, FColumnOrder^, FColumnOrderCount * SizeOf(Integer));
  1041.   end else begin
  1042.     if FColumnOrder <> NIL then
  1043.     begin
  1044.       Move(FColumnOrder^, IntArray, Count * SizeOf(Integer));
  1045.       Result := TRUE;
  1046.     end else
  1047.       Result := FALSE;
  1048.   end;
  1049. end;
  1050.  
  1051. procedure TExtListView.SetHotItem(Val: integer);
  1052. begin
  1053.   if HandleAllocated then
  1054.     ListView_SetHotItem(Handle, Val);
  1055. end;
  1056.  
  1057. function TExtListView.GetHotItem: integer;
  1058. begin
  1059.   if HandleAllocated then
  1060.     Result := ListView_GetHotItem(Handle)
  1061.   else
  1062.     Result := -1;
  1063. end;
  1064.  
  1065. procedure TExtListView.SetHotCursor(const Val: HCursor);
  1066. begin
  1067.   if HandleAllocated then
  1068.     ListView_SetHotCursor(Handle, Val);
  1069. end;
  1070.  
  1071. function TExtListView.GetHotCursor: HCursor;
  1072. begin
  1073.   if HandleAllocated then
  1074.     Result := ListView_GetHotCursor(Handle)
  1075.   else
  1076.     Result := 0;
  1077. end;
  1078.  
  1079. function TExtListView.ApproximateViewRect(Count: integer; const Proposed: TPoint): TPoint;
  1080. var
  1081.   Res: DWORD;
  1082. begin
  1083.   if HandleAllocated then
  1084.   begin
  1085.     Res := ListView_ApproximateViewRect(Handle, Count, Proposed.X, Proposed.Y);
  1086.     Result := Point(LoWord(Res), HiWord(Res));
  1087.   end else
  1088.     Result := Point(-1, -1);
  1089. end;
  1090.  
  1091. procedure TExtListView.SetWorkArea(Rect: TRect);
  1092. begin
  1093.   if HandleAllocated then
  1094.     ListView_SetWorkArea(Handle, Rect);
  1095. end;
  1096.  
  1097. procedure TExtListView.SetCheckState(Index: integer; Checked: boolean);
  1098. begin
  1099.   if HandleAllocated then
  1100.     ListView_SetCheckState(Handle, Index, Checked);
  1101. end;
  1102.  
  1103. function TExtListView.GetCheckState(Index: integer): boolean;
  1104. begin
  1105.   if HandleAllocated then
  1106.     Result := ListView_GetCheckState(Handle, Index)
  1107.   else
  1108.     Result := FALSE;
  1109. end;
  1110.  
  1111. procedure TExtListView.SetItemCountEx(Count: integer; Flags: TLVItemCountFlags);
  1112. var
  1113.   APIFlags: DWORD;
  1114. begin
  1115.   if HandleAllocated then
  1116.   begin
  1117.     APIFlags := 0;
  1118.     if lvsicfNoInvalidateAll in Flags then
  1119.       APIFlags := LVSICF_NOINVALIDATEALL;
  1120.     if lvsicfNoScroll in Flags then
  1121.       APIFlags := APIFlags or LVSICF_NOSCROLL;
  1122.     ListView_SetItemCountEx(Handle, Count, APIFlags);
  1123.   end;
  1124. end;
  1125.  
  1126. procedure TExtListView.SetVirtualMode(Val: boolean);
  1127. var
  1128.   H: HWND;
  1129. begin
  1130.   if Val = FVirtualMode then exit;
  1131.   FVirtualMode := Val;
  1132.   RecreateWnd;
  1133. {$IFDEF DEBUG}
  1134.   H := Handle; { Desperate attempt to fix a nasty bug I can't reproduce }
  1135.   if H = 0 then
  1136.     raise Exception.Create('Failed to recreate window handle.  Contact Brad.');
  1137. {$ENDIF}
  1138. end;
  1139.  
  1140.  
  1141. procedure TExtListView.CNNotify(var Message: TWMNotify);
  1142. begin
  1143.   with Message.NMHdr^ do begin
  1144.     Message.Result := 0;
  1145.     if FVirtualMode then begin
  1146.       case code of
  1147.         LVN_GETDISPINFO:    VMGetDispInfo(PLVDispInfoEx(pointer(Message.NMHdr))^.item);
  1148.         LVN_ODCACHEHINT:    VMCacheHint(PNMCacheHint(pointer(Message.NMHdr))^);
  1149.         LVN_ODSTATECHANGED: VMStateChanged(PNMODStateChange(pointer(Message.NMHdr))^);
  1150.         LVN_ODFINDITEM:
  1151.           Message.Result := VMFindItem(PNMFindItem(pointer(Message.NMHdr))^);
  1152.       else
  1153.         inherited;
  1154.       end;
  1155.     end else begin
  1156.       case code of
  1157.         LVN_ITEMACTIVATE:
  1158.           begin
  1159.             ItemActivate;
  1160.             Message.Result := 0;
  1161.           end;
  1162.         LVN_MARQUEEBEGIN:
  1163.           begin
  1164.             if MarqueeBegin then
  1165.               Message.Result := 0
  1166.             else
  1167.               Message.Result := 1;
  1168.           end;
  1169.       else
  1170.         inherited;
  1171.       end;
  1172.     end;
  1173.   end;
  1174. end;
  1175.  
  1176.  
  1177. procedure TExtListView.WMNotify(var Message: TWMNotify);
  1178. begin
  1179.   inherited;
  1180.   // For some reason, the SECOND time you drag a header width, it toasts the bitmap.
  1181.   // I think it has to do with the TListView class somehow resetting the column
  1182.   // information, overwriting our information (image info).  Anyway, catching the
  1183.   // condition (begin column header drag) and resetting all the extended information
  1184.   // for that column fixes it.
  1185.   if Message.NMHdr.code = HDN_BEGINTRACK then
  1186.     UpdateColumnImage(PHDNotify(Message.NMHdr).Item);
  1187. end;
  1188.  
  1189.  
  1190. function TExtListView.MarqueeBegin: boolean;
  1191. begin
  1192.   Result := TRUE;
  1193.   if assigned(FOnMarqueeBegin) then
  1194.     FOnMarqueeBegin(Self, Result);
  1195. end;
  1196.  
  1197. procedure TExtListView.ItemActivate;
  1198. begin
  1199.   if assigned(FOnItemActivate) then
  1200.     FOnItemActivate(Self);
  1201. end;
  1202.  
  1203. procedure TExtListView.VMGetDispInfo(var ItemInfo: TLVItemEx);
  1204.   function MaskFlagsToSet(Mask: UINT): TLVVMMaskItems;
  1205.   begin
  1206.     Result := [];
  1207.     if (Mask and LVIF_TEXT) = LVIF_TEXT then
  1208.       Include(Result, lvifText);
  1209.     if (Mask and LVIF_IMAGE) = LVIF_IMAGE then
  1210.       Include(Result, lvifImage);
  1211.     if (Mask and LVIF_PARAM) = LVIF_PARAM then
  1212.       Include(Result, lvifParam);
  1213.     if (Mask and LVIF_STATE) = LVIF_STATE then
  1214.       Include(Result, lvifState);
  1215.     if (Mask and LVIF_INDENT) = LVIF_INDENT then
  1216.       Include(Result, lvifIndent);
  1217.   end;
  1218. var
  1219.   Text: string;
  1220.   NewState: integer;
  1221.   GetMask: TLVVMMaskItems;
  1222. begin
  1223.   if ItemInfo.iItem = -1 then exit;  // No way.
  1224.   Text := '';
  1225.   NewState := ItemInfo.State;
  1226.   GetMask := MaskFlagsToSet(ItemInfo.Mask);
  1227.   if assigned(FOnVMGetItemInfo) then begin
  1228.     with ItemInfo do
  1229.       FOnVMGetItemInfo(Self, iItem, iSubItem, GetMask,
  1230.                        iImage, lParam, NewState, iIndent, Text);
  1231.     if (ItemInfo.mask and LVIF_TEXT) = LVIF_TEXT then
  1232.       StrLCopy(ItemInfo.pszText, PChar(Text), ItemInfo.cchTextMax);
  1233.     ItemInfo.State := NewState;
  1234.   end;
  1235. end;
  1236.  
  1237. procedure TExtListView.VMCacheHint(var HintInfo: TNMCacheHint);
  1238. begin
  1239.   if assigned(FOnVMCacheHint) then
  1240.     FOnVMCacheHint(Self, HintInfo);
  1241. end;
  1242.  
  1243. function TExtListView.VMFindItem(var FindInfo: TNMFindItem): integer;
  1244. begin
  1245.   Result := -1;
  1246.   if assigned(FOnVMFindItem) then
  1247.     FOnVMFindItem(Self, FindInfo, Result);
  1248. end;
  1249.  
  1250. procedure TExtListView.VMStateChanged(var StateInfo: TNMODStateChange);
  1251. begin
  1252.   if assigned(FOnVMStateChanged) then
  1253.     FOnVMStateChanged(Self, StateInfo);
  1254. end;
  1255.  
  1256.  
  1257. procedure TExtListView.StoreSettings;
  1258. var
  1259.   ColCount: integer;
  1260.   ColArray: PIntArray;
  1261. begin
  1262.   with inherited SaveSettings do
  1263.   begin
  1264.     AutoSave := FSaveSettings.AutoSave;
  1265.     RegistryKey := FSaveSettings.RegistryKey;
  1266.     SaveColumnSizes := FSaveSettings.SaveColumnSizes;
  1267.   end;
  1268.  
  1269.   inherited StoreSettings;
  1270.  
  1271.   if FSaveSettings.AutoSave and (not(csDesigning in ComponentState)) then begin
  1272.     ColCount := Columns.Count;
  1273.     if FSaveSettings.SaveColumnOrder and (ColCount > 0) then begin
  1274.       GetMem(ColArray, SizeOf(Integer)*ColCount);
  1275.       try
  1276.         GetColumnOrder(ColCount, ColArray^);
  1277.         FSaveSettings.StoreColumnOrder(ColCount, ColArray^);
  1278.       finally
  1279.         FreeMem(ColArray);
  1280.       end;
  1281.     end;
  1282.   end;
  1283. end;
  1284.  
  1285. procedure TExtListView.LoadSettings;
  1286. var
  1287.   ColCount: integer;
  1288.   ColArray: PIntArray;
  1289. begin
  1290.   with inherited SaveSettings do
  1291.   begin
  1292.     AutoSave := FSaveSettings.AutoSave;
  1293.     RegistryKey := FSaveSettings.RegistryKey;
  1294.     SaveColumnSizes := FSaveSettings.SaveColumnSizes;
  1295.   end;
  1296.  
  1297.   inherited LoadSettings;
  1298.  
  1299.   if FSaveSettings.AutoSave and (not(csDesigning in ComponentState)) then begin
  1300.     ColCount := Columns.Count;
  1301.     if FSaveSettings.SaveColumnOrder and (ColCount > 0) then begin
  1302.       GetMem(ColArray, SizeOf(Integer)*ColCount);
  1303.       try
  1304.         FSaveSettings.ReadColumnOrder(ColCount, ColArray^);
  1305.         SetColumnOrder(ColCount, ColArray^);
  1306.       finally
  1307.         FreeMem(ColArray);
  1308.       end;
  1309.     end;
  1310.   end;
  1311. end;
  1312.  
  1313. procedure TExtListView.ColumnHeaderImagesChange(Sender: TObject);
  1314. begin
  1315.   UpdateColumnsImages; { Images changed }
  1316. end;
  1317.  
  1318.  
  1319. {procedure TExtListView.SetColumnHeaderImages(Value: TImageList);
  1320. begin
  1321. end;}
  1322.  
  1323. procedure TExtListView.SetColumnsFormat(Value: TExtListColumns);
  1324. begin
  1325.   FColumnsFormat.Assign(Value);
  1326. end;
  1327.  
  1328. procedure TExtListView.UpdateColumnsImages;
  1329. var
  1330.   i: Integer;
  1331. begin
  1332.   if HandleAllocated then
  1333.     for i := 0 to Columns.Count - 1 do UpdateColumnImage(i);
  1334. end;
  1335.  
  1336. procedure TExtListView.UpdateColumnImage(Index: integer);
  1337.   function ValidImages: boolean;
  1338.   begin
  1339.     Result := assigned(SmallImages) and (SmallImages.Count > 0);
  1340.   end;
  1341. var
  1342.   Column: TLVColumnEx;
  1343. begin { UpdateColumnImage }
  1344.   if HandleAllocated and (Index > -1) and (Index < FColumnsFormat.Count) and ValidImages then
  1345.   begin
  1346.     FillChar(Column, SizeOf(Column), #0);
  1347.     ListView_GetColumnEx(Handle, Index, Column);
  1348.     with Column, FColumnsFormat[Index] do begin
  1349.       if (ImageIndex <> -1) then
  1350.       begin
  1351.         iImage := ImageIndex;
  1352.         mask := mask or LVCF_IMAGE or LVCF_FMT;  // Add LVCF_FMT Just to make sure...
  1353.         fmt  := fmt or LVCFMT_IMAGE;
  1354.         case Columns.Items[Index].Alignment of
  1355.           taLeftJustify: fmt := fmt or LVCFMT_LEFT;
  1356.           taCenter: fmt := fmt or LVCFMT_CENTER;
  1357.           taRightJustify: fmt := fmt or LVCFMT_RIGHT;
  1358.         end;
  1359.         if ImageAlignment = ciaRightOfText then
  1360.           fmt := fmt or LVCFMT_BITMAP_ON_RIGHT;
  1361.       end else begin
  1362.         mask := LVCF_FMT;
  1363.         fmt  := fmt and not LVCFMT_IMAGE and not LVCFMT_BITMAP_ON_RIGHT;
  1364.       end;
  1365.     end;
  1366.     ListView_SetColumnEx(Handle, Index, Column);
  1367.   end;
  1368. end;
  1369.  
  1370.  
  1371.  
  1372. { TColumnListImage }
  1373.  
  1374. constructor TExtListColumn.Create(Collection: TCollection);
  1375. begin
  1376.   inherited Create(Collection);
  1377.   FSmallImageIndex := -1;
  1378.   FImageAlignment := ciaRightOfText;
  1379. end;
  1380.  
  1381. destructor TExtListColumn.Destroy;
  1382. begin
  1383.   FSmallImageIndex := -1;
  1384.   FImageAlignment := ciaRightOfText;
  1385.   DoChange;
  1386.   inherited Destroy;
  1387. end;
  1388.  
  1389. procedure TExtListColumn.DoChange;
  1390. var
  1391.   i: Integer;
  1392. begin
  1393.   for i := 0 to Collection.Count-1 do
  1394.     Changed(i <> Collection.Count);
  1395. end;
  1396.  
  1397. procedure TExtListColumn.SetSmallImageIndex(Value: Integer);
  1398. begin
  1399.   if FSmallImageIndex <> Value then
  1400.   begin
  1401.     FSmallImageIndex := Value;
  1402.     If FSmallImageIndex = -1 then
  1403.       FImageAlignment  := ciaRightOfText;
  1404.     DoChange;
  1405.   end;
  1406. end;
  1407.  
  1408. procedure TExtListColumn.SetImageAlignment(Value: TColumnImageAlign);
  1409. begin
  1410.   if FImageAlignment <> Value then
  1411.   begin
  1412.     FImageAlignment := Value;
  1413.     DoChange;
  1414.   end;
  1415. end;
  1416.  
  1417. procedure TExtListColumn.Assign(Source: TPersistent);
  1418. var
  1419.   Column: TExtListColumn;
  1420. begin
  1421.   if Source is TExtListColumn then
  1422.   begin
  1423.     Column := TExtListColumn(Source);
  1424.     ImageIndex := Column.ImageIndex;
  1425.     ImageAlignment  := Column.ImageAlignment;
  1426.   end else
  1427.     inherited Assign(Source);
  1428. end;
  1429.  
  1430. { TListColBitMaps }
  1431.  
  1432. constructor TExtListColumns.Create(AOwner: TExtListView);
  1433. begin
  1434.   inherited Create(TExtListColumn);
  1435.   FOwner := AOwner;
  1436. end;
  1437.  
  1438. function TExtListColumns.GetItem(Index: Integer): TExtListColumn;
  1439. begin
  1440.   Result := TExtListColumn(inherited GetItem(Index));
  1441. end;
  1442.  
  1443. procedure TExtListColumns.SetItem(Index: Integer; Value: TExtListColumn);
  1444. begin
  1445.   inherited SetItem(Index, Value);
  1446. end;
  1447.  
  1448. function TExtListColumns.Add: TExtListColumn;
  1449. begin
  1450.   Result := TExtListColumn(inherited Add);
  1451. end;
  1452.  
  1453. function TExtListColumns.GetOwner: TPersistent;
  1454. begin
  1455.   Result := FOwner;
  1456. end;
  1457.  
  1458. procedure TExtListColumns.Update(Item: TCollectionItem);
  1459. begin
  1460.   if Owner <> NIL then
  1461.   begin
  1462.     if Item <> NIL then
  1463.       Owner.UpdateColumnImage(Item.Index)
  1464.     else
  1465.       Owner.UpdateColumnsImages;
  1466.   end;
  1467. end;
  1468.  
  1469. procedure TExtListColumns.Refresh;
  1470. begin
  1471.   if Owner <> NIL then
  1472.     Owner.UpdateColumnsImages;
  1473. end;
  1474.  
  1475. procedure TExtListColumns.Assign(Source: TPersistent);
  1476. begin
  1477.   Clear;
  1478.   inherited Assign(Source);
  1479. end;
  1480.  
  1481.  
  1482. end.
  1483.  
  1484.